home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1262 / samples / exmpl2.pr_ / exmpl2.pr
Text File  |  1995-03-14  |  10KB  |  287 lines
  1. /* Generated by EasyCODE(SPX) V5.1 at 15.03.1995 18:47:10
  2.    with C:\EASY\SAMPLES\SPX-XBS\CLIPPER.CFG */
  3.  
  4. /* EXMPL2 */
  5.  
  6. #include "h:\apps\clipper5\include\inkey.ch"
  7. /* **** Prepare datenbase **** */
  8.    USE TEST2 NEW
  9.    SET INDEX TO TEST23, TEST21, TEST22
  10.    GO TOP
  11.    USE TEST1 NEW
  12.    SET INDEX TO TEST11, TEST12
  13.    GO TOP
  14.    SELECT TEST2
  15. /* **** Initialize local variables **** */
  16.    *
  17.    * Local variables
  18.    *
  19.    * Datbase temporary fields
  20.    *
  21.    PRIVATE L_FINYEAR, L_COUNTER, L_TESTNEW, ;
  22.    L_TESTAGE, L_TESTLOCATION, L_BUILD, TEST1OK, L_COMMENT
  23.  
  24.          
  25.          
  26.    PRIVATE L_CD, L_ANSWER, SKEY1, SKEY       
  27.    TEST1OK := .T.
  28.    setcur(1)
  29.    L_CD := " "
  30.    test1init()
  31. /* **** Static text for screen **** */
  32.    menu1("Get test data")
  33.    @  9, 4 SAY "Date (YY/MM/TT):"
  34.    @ 11, 4 SAY "Counter:"
  35.    @ 13, 4 SAY "Test location:"
  36.    @ 13,50 SAY "Building:"
  37.    @ 15, 4 SAY "Test stand:"
  38.    @ 17, 4 SAY "Comment: "
  39. /* *** Processing **** */
  40.    /* **** Call screen **** */
  41.       Test1Data(L_COUNTER)
  42.       L_TESTLOCATION     := TEST1->TESTLOCATION
  43.       L_BUILD         := TEST1->BUILDING
  44.       dtest1()
  45.         CLEAR GETS
  46.    /* **** Processing loop **** */
  47.       DO WHILE .T.
  48.         @ 6,4 SAY "BC: " GET L_CD PICTURE "!" valid cdcheck(L_CD,1)
  49.         @   9, 25 GET L_FINYEAR         PICTURE "99/99/99" WHEN L_CD $"CND" valid datok(L_FINYEAR)
  50.         @  11, 25 GET L_COUNTER         PICTURE "@K !!!!!!!!" WHEN L_CD $"CND"
  51.         READ
  52.         IF L_CD = "E"
  53.           EXIT
  54.         ENDIF
  55.         DO CASE
  56.            CASE       (      (L_CD = "N");
  57.                        .OR.  (L_CD = "C"));
  58.                 .AND. (Test1Data(L_COUNTER))
  59.               /* Process "N" + "C" */
  60.                  IF       (L_CD = "N");
  61.                     .AND. (TestData(L_FINYEAR, L_COUNTER))
  62.                    msg(22,"Record already exists!")
  63.                    LOOP
  64.                  ENDIF
  65.                  IF L_CD = "N"
  66.                    L_TESTNEW     := 0
  67.                    L_COMMENT    := SPACE(30)
  68.                    L_TESTLOCATION      := TEST1->TESTLOCATION
  69.                    L_BUILD          := TEST1->BUILDING
  70.                  ELSE
  71.                    IF TestData(L_FINYEAR,  L_COUNTER)
  72.                      L_FINYEAR     := SUBSTR(TEST2->FINYEAR,1,2) +;
  73.                                         "/" + SUBSTR(TEST2->FINYEAR,3,2) +;
  74.                                         "/" + SUBSTR(TEST2->FINYEAR,5,2)
  75.                      L_COUNTER     := TEST2->COUNTER
  76.                      L_TESTNEW       := TEST2->TESTNEW
  77.                      L_COMMENT     := TEST2->COMMENT
  78.                      L_TESTLOCATION := TEST1->TESTLOCATION
  79.                      L_BUILD     := TEST1->BUILDING
  80.                    ELSE
  81.                      msg(22,"Record"+ ;
  82.                      " not found!")
  83.                      LOOP
  84.                    ENDIF
  85.                  ENDIF
  86.                  DO WHILE .T.
  87.                    /* **** Further processing **** */
  88.                       SET KEY 6 TO ENDKEY
  89.                       DO WHILE       (LASTKEY() <> K_PGDN);
  90.                                .AND. (LASTKEY() <> K_ESC)
  91.                         dtest1()
  92.                         READ
  93.                       ENDDO
  94.                       SET KEY 6 TO
  95.                       IF LASTKEY() <> K_ESC
  96.                         sptest1()
  97.                       ENDIF
  98.                       IF       (L_ANSWER = "J");
  99.                          .OR.  (LASTKEY() = K_ESC)
  100.                         EXIT
  101.                       ENDIF
  102.                  ENDDO
  103.            CASE L_CD = "V"
  104.               /* Process "V" */
  105.                  SKIP + 1
  106.                  IF EOF()
  107.                    msg(22,"EOF reached")
  108.                    GO BOTTOM
  109.                  ENDIF
  110.                  L_COUNTER:= TEST2->COUNTER
  111.                  IF       (Test1Data(L_COUNTER));
  112.                     .OR.  (Test2Data(L_COUNTER))
  113.                    test1init()
  114.                    @  9, 25 GET L_FINYEAR       PICTURE "xxxxxxxx"
  115.                    @ 11, 25 GET L_COUNTER        PICTURE "xxxxxxxx"
  116.                    dtest1()
  117.                    CLEAR GETS
  118.                  ENDIF
  119.            CASE L_CD = "Z"
  120.               /* Process "Z" */
  121.                  SKIP - 1
  122.                  IF EOF()
  123.                    msg(22,"EOF reached")
  124.                    GO BOTTOM
  125.                  ENDIF
  126.                  L_COUNTER:= TEST2->COUNTER
  127.                  IF       (Test1Data(L_COUNTER));
  128.                     .OR.  (Test2Data(L_COUNTER))
  129.                    test1init()
  130.                    @  9, 25 GET L_FINYEAR       PICTURE "xxxxxxxx"
  131.                    @ 11, 25 GET L_COUNTER       PICTURE "xxxxxxxx"
  132.                    dtest1()
  133.                    CLEAR GETS
  134.                  ENDIF
  135.            CASE       (L_CD = "D");
  136.                 .AND. (Test1Data(L_COUNTER))
  137.               /* Process "D" */
  138.                  L_ANSWER := " "
  139.                  IF TestData(L_FINYEAR, L_COUNTER)
  140.                    L_TESTNEW := TEST2->TESTNEW
  141.                    IF       (Test1Data(L_COUNTER));
  142.                       .OR.  (Test2Data(L_COUNTER))
  143.                      L_TESTLOCATION := TEST1->TESTLOCATION
  144.                      L_BUILD := TEST1->BUILDING
  145.                    ELSE
  146.                      L_TESTLOCATION := SPACE(20)
  147.                      L_BUILD := SPACE(3)
  148.                    ENDIF
  149.                    @ 13, 25 GET L_TESTLOCATION        PICTURE "xxxxxxxxxxxxxxxxxxxx"
  150.                    @ 13, 63 GET L_BUILD             PICTURE "xxx"
  151.                    @ 15, 25 GET L_TESTNEW        PICTURE "9999999"
  152.                    @ 17, 25 GET L_COMMENT       PICTURE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  153.                    CLEAR GETS
  154.                    L_ANSWER = "J"
  155.                    IF L_ANSWER = "J"
  156.                      DELETE
  157.                      GO TOP
  158.                    ENDIF
  159.                  ELSE
  160.                    msg(22,"Record not found")
  161.                  ENDIF
  162.                  L_COUNTER := TEST2->COUNTER
  163.                  L_FINYEAR := SUBSTR(TEST2->FINYEAR,1,2) + "/" ;
  164.                                 + SUBSTR(TEST2->FINYEAR,3,2) + ;
  165.                                 "/" + SUBSTR(TEST2->FINYEAR,5,2)
  166.                  IF       (Test1Data(L_COUNTER));
  167.                     .OR.  (Test2Data(L_COUNTER))
  168.                    TEST1init()
  169.                    @  9, 25 GET L_FINYEAR       PICTURE "xxxxxxxx"
  170.                    @ 11, 25 GET L_COUNTER       PICTURE "xxxxxxxx"
  171.                    dTEST1()
  172.                    CLEAR GETS
  173.                  ENDIF
  174.            OTHERWISE
  175.               LOOP
  176.         ENDCASE
  177.       ENDDO
  178. /* **** Exit program **** */
  179.    setcur(0)
  180.    bsset(1)
  181.    CLOSE DATA
  182.    CLEAR
  183.    RETURN
  184. /* *** Procedure for displaying fields *** */
  185.    PROCEDURE dtest1
  186.      @ 13, 25 GET L_TESTLOCATION        PICTURE "xxxxxxxxxxxxxxxxxxxx"
  187.      @ 13, 63 GET L_BUILD             PICTURE "xxx"
  188.      CLEAR GETS
  189.      @ 15, 25 GET L_TESTNEW        PICTURE "9999999"
  190.      @ 17, 25 GET L_COMMENT       PICTURE "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
  191.    RETURN
  192.  
  193. /* **** Procedure for saving data **** */
  194.    PROCEDURE sptest1
  195.      L_ANSWER = " "
  196.      IF L_ANSWER = "J"
  197.        IF       (L_CD = "N");
  198.           .OR.  (L_CD = "G")
  199.          APPEND BLANK
  200.        ENDIF
  201.        REPLACE TEST2->FINYEAR    WITH SUBSTR(L_FINYEAR,1,2) +;
  202.                                          SUBSTR(L_FINYEAR,4,2) + ;
  203.                                          SUBSTR(L_FINYEAR,7,2)
  204.        REPLACE TEST2->COUNTER    WITH L_COUNTER
  205.        REPLACE TEST2->TESTNDNEU     WITH L_TESTNEW
  206.        REPLACE TEST2->COMMENT        WITH L_COMMENT
  207.      ENDIF
  208.    RETURN
  209.  
  210. /* **** Initialize fields on screen **** */
  211.    PROCEDURE test1init
  212.      IF       (L_CD <> "N");
  213.         .AND. (.NOT. (EOF()))
  214.        L_FINYEAR   := SUBSTR(TEST2->FINYEAR,1,2) +;
  215.                          "/" + SUBSTR(TEST2->FINYEAR,3,2) + ;
  216.                          "/" + SUBSTR(TEST2->FINYEAR,5,2)
  217.        L_COUNTER   := TEST2->COUNTER
  218.        L_TESTNEW     := TEST2->TESTNEW
  219.        L_TESTLOCATION     := TEST1->TESTLOCATION
  220.        L_BUILD         := TEST1->BUILDING
  221.        L_COMMENT   := TEST2->COMMENT
  222.      ELSE
  223.        L_FINYEAR   := "  /  /  "
  224.        L_COUNTER   := SPACE(8)
  225.        L_TESTNEW     := 0
  226.        L_TESTLOCATION     := SPACE(20)
  227.        L_BUILD         := SPACE(3)
  228.        L_COMMENT   := SPACE(30)
  229.  
  230.      ENDIF
  231.    RETURN
  232.  
  233. /* TestData */
  234.    FUNCTION TestData
  235.      PARAMETERS G, Z
  236.      SELECT TEST2
  237.      SKEY := SUBSTR(g,1,2) + ;
  238.              SUBSTR(g,4,2) + SUBSTR(g,7,2) + z
  239.      SEEK  DESCEND(SKEY)
  240.      IF FOUND()
  241.        RETURN(.T.)
  242.      ELSE
  243.        RETURN(.F.)
  244.      ENDIF
  245.  
  246. /* **** Test1Data **** */
  247.    FUNCTION Test1Data
  248.      PARAMETERS ZNR
  249.      PRIVATE OLDA, ADAT, SKEY1
  250.      OLDA := SELECT()
  251.      SKEY1 := SPACE(19)
  252.      ADAT := CTOD("  .  .  ")
  253.      SELECT TEST1
  254.      SET ORDER TO 1
  255.      SKEY1 := ZNR + DTOC(ADAT)
  256.      SEEK SKEY1
  257.      IF !EOF()
  258.        SELECT (OLDA)
  259.        RETURN(.T.)
  260.      ELSE
  261.        msg(22,"Counter ";
  262.         +skey1 +" not found")
  263.        SELECT (OLDA)
  264.        RETURN(.F.)
  265.      ENDIF
  266.  
  267. /* **** Test2Data **** */
  268.    FUNCTION Test2Data
  269.      PARAMETERS L_ZNR
  270.      PRIVATE OLDA, SKEY2,L_ZNR, L_ZAEHLMERK
  271.      OLDA    := SELECT()
  272.      L_ZAEHLMERK := TEST1->COUNTER
  273.      SELECT TEST1
  274.      GO TOP
  275.      AUSB2 := CTOD("  .  .  ")
  276.      DO WHILE TEST1->COUNTER <> L_ZNR 
  277.        SKIP + 1
  278.      ENDDO
  279.      IF TEST1->AUSBAUDAT = AUSB2
  280.        SELECT (OLDA)
  281.        RETURN(.F.)
  282.      ELSE
  283.        SELECT (OLDA)
  284.        RETURN(.T.)
  285.      ENDIF
  286.  
  287.